home *** CD-ROM | disk | FTP | other *** search
/ The Atari Compendium / The Atari Compendium (Toad Computers) (1994).iso / files / prgtools / programm.ing / gfa / gfa_util.arc / WINDTEXT.LST < prev   
Encoding:
File List  |  1991-06-11  |  7.1 KB  |  223 lines
  1. GOTO here
  2. PROCEDURE wind_text(perc,color,title$,text$)
  3.   ' ********************   TEXT WINDOW V1.2   ********************
  4.   '
  5.   '    This procedure will draw a graphics window centered on the screen
  6.   '  in any resolution, and will allow scrolling of text in FOUR DIRECTIONS.
  7.   '  Therefore, the width of the text sent to the procedure is unimportant
  8.   '  and UNLIMITED.
  9.   '
  10.   ' Parameters:
  11.   '            perc   : Percentage of screen window takes up.
  12.   '                     The minimum percent is when the window is less
  13.   '                     than 18 characters...
  14.   '
  15.   '            color  : 0-15  (The current color settings...)
  16.   '                     NOTE : If in med rez, colors 4 and beyond are
  17.   '                            the same as 3.
  18.   '                            If in high rez, use 0 or 1.
  19.   '                            ** '0' is a special default for "B&W", looks
  20.   '                               nice in all rez's!
  21.   '
  22.   '            title$ : String containing the title of the window.
  23.   '                     Title can be blank ("").
  24.   '                     Will be truncated if longer than size of window.
  25.   '
  26.   '            text$  : String containing the text for the window.
  27.   '                 IMPORTANT:  To be built in this manner BEFORE calling
  28.   '                               this procedure :
  29.   '                             text$(0)="Put your text here..."
  30.   '                             text$(1)="Dimension your text string var"
  31.   '                             text$(2)=" to be of the correct size."
  32.   '                             text$(3)="Each line can be an UNLIMITED width"
  33.   '                             text$(4)="and will still be viewable."
  34.   '                             text$(5)="The output will look just like"
  35.   '                             text$(6)="it does in this listing..."
  36.   '                             text$(7)=""
  37.   '                             text$(8)="Etc, etc...  "
  38.   '                             text$(9)="Blah blah blah"
  39.   '                             text$(10)=" ALWAYS END THE TEXT LIKE THIS:"
  40.   '                             text$(11)="\q"
  41.   '
  42.   '                     IT IS YOUR RESPONSIBILITY TO END THE TEXT LIKE ABOVE--
  43.   '
  44.   ' Examples of use :
  45.   '
  46.   '             wind_text(55,2,"MAIN MENU",message$)
  47.   '
  48.   '                         -or-
  49.   '
  50.   '             wperc=87
  51.   '             wcolor=12
  52.   '             wtitle$="PROGRAM HELP SECTION"
  53.   '             dim text$(3)
  54.   '             text$(0)="Press <ESC> to quit any function..."
  55.   '             text$(1)=""
  56.   '             text$(2)="Blah blah blah"
  57.   '             text$(3)="\q"
  58.   '             wind_text(wperc,wcolor,wtitle$,text$)
  59.   '
  60.   '
  61.   title=-1
  62.   IF title$=""
  63.     title=0
  64.   ENDIF
  65.   rez=XBIOS(4)          ! 0=low, 1=med, 2=hgh
  66.   IF rez=0
  67.     rezx=1              ! Used for screen formatting
  68.     rezy=1
  69.     scr_col=40          ! 40 columns
  70.     scr_width=320       ! Screen width
  71.     scr_length=200      ! Screen length
  72.   ELSE
  73.     rezx=1
  74.     scr_col=80          ! 80 columns
  75.     scr_width=640       ! Screen width
  76.     IF rez=1
  77.       rezy=1
  78.       scr_length=200    ! Screen length
  79.     ELSE
  80.       scr_length=400    !       "
  81.       rezy=2
  82.     ENDIF
  83.   ENDIF
  84.   '
  85.   width=INT(scr_col*(perc/100))    ! Width is certain percentage of screen
  86.   IF width<19
  87.     PRINT "Width is too small for current resolution!"
  88.     GOTO fault
  89.   ENDIF
  90.   '    ***** Draw window *****
  91.   IF color>0
  92.     DEFFILL color,2,8
  93.   ELSE
  94.     DEFFILL 0,0,0
  95.   ENDIF
  96.   upperleftx=INT((scr_width/2)-((width/2)*(8*rezx)))-(2*rezx)
  97.   upperlefty=INT((scr_length/2)-((20/2)*(8*rezy)))-(4*rezy)
  98.   lowerrightx=(upperleftx+(width*(8*rezx)))-(1*rezx)
  99.   lowerrighty=(upperlefty+(20*(8*rezy)))-(2*rezy)
  100.   left_drawx=INT(upperleftx-(2*rezx))
  101.   left_drawy=INT(upperlefty-(2*rezy))
  102.   right_drawx=INT(lowerrightx+(2*rezx))
  103.   right_drawy=INT(lowerrighty+(2*rezy))
  104.   GET left_drawx,left_drawy,right_drawx,right_drawy,scr$
  105.   PBOX left_drawx,left_drawy,right_drawx,right_drawy
  106.   BOX left_drawx,left_drawy,right_drawx,right_drawy
  107.   ulx_pro=INT(upperleftx+((8*width)*rezx))         ! Proportionate up-left
  108.   LINE left_drawx,INT(upperlefty+(8*rezy)),ulx_pro,INT(upperlefty+(8*rezy))
  109.   LINE left_drawx,INT(lowerrighty-(8*rezy)),ulx_pro,INT(lowerrighty-(8*rezy))
  110.   '    ***** Decorate window *****
  111.   IF color>0
  112.     cl$="c"+STR$(color-1)
  113.     PRINT CHR$(27)+LEFT$(cl$,2);
  114.     IF rez=0
  115.       bl$="b"+STR$(color+1)
  116.       PRINT CHR$(27)+LEFT$(bl$,2);
  117.     ENDIF
  118.   ENDIF
  119.   title_len=LEN(title$)
  120.   IF title_len>=width
  121.     j$=SPACE$(width-1)
  122.     LSET j$=title$
  123.     title$=j$
  124.     title_len=width-1
  125.   ENDIF
  126.   PRINT AT(((upperleftx/(8*rezx))+((width/2)-(title_len/2))+1),(upperlefty/(8*rezy))+1);title$;
  127.   PRINT AT(((upperleftx/(8*rezx))+((width/2)-8)+1),(upperlefty/(8*rezy))+20);
  128.   OUT 5,2               ! Draw arrows
  129.   PRINT ",";
  130.   OUT 5,1
  131.   PRINT ",";
  132.   OUT 5,4
  133.   PRINT ",";
  134.   OUT 5,3
  135.   PRINT ", ESC=Exit";
  136.   '    ***** Fill window with text *****
  137.   just$=SPACE$(width-1)           ! To keep overflow from going out of window
  138.   top=0                           ! Starting line to put at top
  139.   tot_len=-1
  140.   w_size=16
  141.   longest=width-2
  142.   REPEAT
  143.     INC tot_len
  144.     t$=text$(tot_len)
  145.     lt=LEN(text$(tot_len))
  146.     IF lt>longest
  147.       longest=lt
  148.     ENDIF
  149.   UNTIL (t$="\q" OR t$="\Q")            ! MUST HAVE A "\Q" or "\q" !!!!
  150.   update=-1
  151.   left=1                                ! Set left pos'n to beginning
  152.   lmar=(upperleftx/8)+2
  153.   REPEAT
  154.     press=0
  155.     IF INP?(2)
  156.       press=INP(2)
  157.     ENDIF
  158.     IF (press=200 AND top>0)            ! If pressed UP
  159.       update=-1
  160.       DEC top
  161.     ENDIF
  162.     IF (press=208 AND ((top+16)<tot_len))          ! If pressed DOWN
  163.       update=-1
  164.       INC top
  165.     ENDIF
  166.     IF (press=203 AND left>1)           ! If pressed LEFT
  167.       update=-1
  168.       DEC left
  169.     ENDIF
  170.     IF (press=205 AND (left+(width-2))<=longest)    ! If pressed RIGHT
  171.       update=-1
  172.       INC left
  173.     ENDIF
  174.     IF update=-1
  175.       IF ((tot_len-top)<w_size)         ! If all is less than size of window
  176.         FOR rows=0 TO (tot_len-top)-1
  177.           LSET just$=MID$(text$(rows+top),left,width-1)
  178.           PRINT AT(lmar,5+rows);just$;
  179.         NEXT rows
  180.       ELSE
  181.         FOR rows=0 TO 15
  182.           LSET just$=MID$(text$(rows+top),left,width-1)
  183.           PRINT AT(lmar,5+rows);just$;
  184.         NEXT rows
  185.       ENDIF
  186.     ENDIF
  187.     update=0
  188.   UNTIL (press=27)
  189.   '
  190.   fault:
  191.   PAUSE 5
  192.   PUT INT(upperleftx-(2*rezx)),(upperlefty-(2*rezy)),scr$
  193.   CLR scr$
  194.   PRINT CHR$(27)+"c0";
  195.   PRINT CHR$(27)+"b3";
  196. RETURN
  197. '
  198. PROCEDURE fill_text
  199.   DIM text$(100)
  200.   ctr=0
  201.   READ t$
  202.   title$=t$
  203.   REPEAT
  204.     READ t$
  205.     text$(ctr)=t$
  206.     INC ctr
  207.   UNTIL (t$="\q")
  208.   DATA Dennis' Super Dooper Menu!!!!!!
  209.   DATA Hello, this is a test of the emergency broadcasting system...,I repeat -- this is ONLY a test!
  210.   DATA I am just about finished filling up the menu so I will go soon!,"",But wait!  Maybe not!
  211.   DATA I figured I'd stay around a while longer!,\q
  212. RETURN
  213. '
  214. here:
  215. PRINT AT(1,1);
  216. FOR t=1 TO 23
  217.   PRINT AT(1,t);STRING$(39,"*");
  218. NEXT t
  219. fill_text
  220. REPEAT
  221.   wind_text(INT(100*RND(0)),0,title$,text$)
  222. UNTIL (left=2)
  223.